procedure CheckForStack;
begin
  if nPics=0 then begin
    PutMessage('This macro requires a stack.');
    exit;
  end;
  if nSlices=0 then begin
    PutMessage('This window is not a stack.');
    exit
  end;
end;

procedure CheckForSelection;
var 
  x1,y1,x2,y2,LineWidth:integer;
  RoiLeft,RoiTop,RoiWidth,RoiHeight:integer;
begin
  GetRoi(RoiLeft,RoiTop,RoiWidth,RoiHeight);
  GetLine(x1,y1,x2,y2,LineWidth);
  if (RoiWidth=0) or (x1>=0) then begin
    PutMessage('Please select square for ACF');
    exit;
  end;
end;



macro 'make grid           [G]';
var
x,y,left,top,width,height,size:integer;
i,nx,ny:integer;
begin
GetPicSIze(width,height);
size:=GetNumber('spacing ? (pixel) ',256);
nx:=trunc(width/size);
ny:=trunc(height/size);
	SetForegroundColor(0);

for i:=1 to nx do begin
x:=i*size;
y:=0;
MoveTo(x,y);
LineTo(x,height);
end;

for i:=1 to ny do begin
x:=0;
y:=i*size;
MoveTo(x,y);
LineTo(width,y);
end;

end;
 

macro 'make 2n*2n ROI  [1]';
var
left,top,width,height:integer;
begin
width:=GetNumber('size of ACF',256);
MakeRoi(0,0,width,width);
end;




macro '(-' begin end;

macro 'single ACF of ROI in 2-layer stack             [2]';
var
  i,j,x,y,z,w,h,angN,angE,angH:integer;
 xx,yy,dummy,n,mean,mode,min,max:integer;
  wacf,w2acf,nACF,xc,yc:integer;
   fft1, fft2,fft0: integer;


begin
CheckForStack;
SelectSlice(1);

CheckForSelection;
GetRoi(xx,yy,w,h);

x:=xx;
y:=yy;
wacf:=w;
MakeRoi(x,y,wacf,wacf);

			fft('foreward');
   fft1 := pidNumber;
   ImageMath('cmul', fft1, fft1, 1, 0, 'FFT2');
   fft2 := pidNumber;
   SelectPic(fft1);
   Dispose;
   SelectPic(fft2);
			fft('Inverse');
   fft('Swap Quadrants');
SelectAll;
Copy;
Dispose;

ChooseSlice(2);
MakeRoi(x,y,wacf,wacf);
Paste;
SelectSlice(1);

end;

macro 'single ACF-center of ROI in 2-layer-stack [3]';
var
  i,j,x,y,z,w,h,angN,angE,angH:integer;
 xx,yy,dummy,n,mean,mode,min,max:integer;
  wacf,corner,center:integer;
   fft1, fft2,fft0: integer;


begin
CheckForStack;
SelectSlice(1);
CheckForSelection;
GetRoi(xx,yy,w,h);

x:=xx;
y:=yy;
wacf:=w;
center:=wacf/2;
corner:=center/2;
SelectSlice(1);
MakeRoi(x,y,wacf,wacf);

			fft('foreward');
   fft1 := pidNumber;
   ImageMath('cmul', fft1, fft1, 1, 0, 'FFT2');
   fft2 := pidNumber;
   SelectPic(fft1);
   Dispose;
   SelectPic(fft2);
			fft('Inverse');
   fft('Swap Quadrants');

MakeRoi(corner,corner,center,center);
Copy;
Dispose;

ChooseSlice(2);
MakeRoi(x+corner,y+corner,center,center);
Paste;
SelectSlice(1);
MakeRoi(x,y,wacf,wacf);

end;

macro '(-' begin end;

macro 'strip of ACFs in 2-layer-stack            [4]';
var
  i,j,x,y,z,azi,inc,angN,angE,angH:integer;
 xx,yy,dummy,n,mean,mode,min,max:integer;
  wacf,w2acf,nACF,xc,yc:integer;
  wim,him, fft1, fft2,fft0: integer;


begin
CheckForStack;
SelectSlice(1);
GetPicSIze(wim,him);
xx:= GetNumber('Upper left corner of first ACF: x= ',0);
yy:= GetNumber('Upper left corner of first ACF: y= ',0);
wacf:= GetNumber('size of ACFs ',256);
max:=trunc((wim-xx)/wacf);
nACF:= GetNumber('Number of ACFs per strip ',max);
for i:=1 to nACF do begin
x:=xx+(i-1)*wacf;
y:=yy;
SelectSlice(1);
MakeRoi(x,y,wacf,wacf);

			fft('foreward');
   fft1 := pidNumber;
   ImageMath('cmul', fft1, fft1, 1, 0, 'FFT2');
   fft2 := pidNumber;
   SelectPic(fft1);
   Dispose;
   SelectPic(fft2);
			fft('Inverse');
   fft('Swap Quadrants');
SelectAll;
Copy;
Dispose;

ChooseSlice(2);
MakeRoi(x,y,wacf,wacf);
Paste;
DoCopy;
end;

SelectSlice(1);
end;

macro 'strip of ACF-centers in 2-layer-stack [5]';
var
  i,j,x,y,z,w,h,wim,him:integer;
 xx,yy,dummy,n,mean,mode,min,max:integer;
  wacf,nACF,corner,center:integer;
   fft1, fft2,fft0: integer;

begin

SelectSlice(1);
CheckForStack;
GetPicSIze(wim,him);
wacf:= GetNumber('size of ACFs ',256);
xx:= GetNumber('Upper left corner of first ACF: x= ',0);
yy:= GetNumber('Upper left corner of first ACF: y= ',0);
max:=trunc(2*((wim-xx)/wacf))-1;
nACF:= GetNumber('Number of ACFs ? max = ',max);
center:=wacf/2;
corner:=center/2;

for i:=1 to nACF do begin

x:=xx+(i-1)*center;
y:=yy;
SelectSlice(1);
MakeRoi(x,y,wacf,wacf);

			fft('foreward');
   fft1 := pidNumber;
   ImageMath('cmul', fft1, fft1, 1, 0, 'FFT2');
   fft2 := pidNumber;
   SelectPic(fft1);
   Dispose;
   SelectPic(fft2);
			fft('Inverse');
   fft('Swap Quadrants');

MakeRoi(corner,corner,center,center);
Copy;
Dispose;

ChooseSlice(2);
MakeRoi(x+corner,y+corner,center,center);
Paste;
CoCopy;
SelectSlice(1);

end;

end;

macro '(-' begin end;


macro 'tiling of ACF-centers in 2-layer-stack [6]';
var
  i,j,x,y,z,w,h,wim,him:integer;
 xx,yy,dummy,n,mean,mode,min,max:integer;
  wacf,nACFx,nACFy,corner,center:integer;
   fft1, fft2,fft0: integer;

begin

SelectSlice(1);
CheckForStack;
GetPicSIze(wim,him);
wacf:= GetNumber('size of ACFs ',256);
xx:= GetNumber('Upper left corner of first ACF: x= ',0);
yy:= GetNumber('Upper left corner of first ACF: y= ',0);
max:=trunc(2*((wim-xx)/wacf)-1);
nACFx:= GetNumber('Number of ACFs in x-direction ? max = ',max);
max:=trunc(2*((him-yy)/wacf)-1);
nACFy:= GetNumber('Number of ACFs in y-direction ? max = ',max);
center:=wacf/2;
corner:=center/2;

for j:=1 to nACFy do begin
for i:=1 to nACFx do begin

x:=xx+(i-1)*center;
y:=yy+(j-1)*center;
SelectSlice(1);
MakeRoi(x,y,wacf,wacf);

			fft('foreward');
   fft1 := pidNumber;
   ImageMath('cmul', fft1, fft1, 1, 0, 'FFT2');
   fft2 := pidNumber;
   SelectPic(fft1);
   Dispose;
   SelectPic(fft2);
			fft('Inverse');
   fft('Swap Quadrants');

MakeRoi(corner,corner,center,center);
Copy;
Dispose;

ChooseSlice(2);
MakeRoi(x+corner,y+corner,center,center);
Paste;
DoCopy;
SelectSlice(1);

end;
end;

end;

macro 'tiling of ACF-centers in 3-layer stack  [7]';
var
  i,j,x,y,z,w,h,wim,him:integer;
 xx,yy,dummy,n,mean,mode,min,max:integer;
  wacf,nACFx,nACFy,corner,center:integer;
   fft1, fft2,fft0: integer;
  threshold,index,tarea,darea,sum:integer;

begin

CheckForStack;
SelectSlice(1);
GetPicSIze(wim,him);
wacf:= GetNumber('size of ACFs ',256);
xx:= GetNumber('Upper left corner of first ACF: x= ',0);
yy:= GetNumber('Upper left corner of first ACF: y= ',0);
max:=trunc(2*((wim-xx)/wacf))-1;
nACFx:= GetNumber('Number of ACFs in x-direction ? max = ',max);
max:=trunc(2*((him-yy)/wacf))-1;
nACFy:= GetNumber('Number of ACFs in y-direction ? max = ',max);
center:=wacf/2;
corner:=center/2;
darea:=(center*center)/50;
darea:=GetNumber('Thresholded ACF size? 2% area =',darea);
threshold:=center*center-darea;

for j:=1 to nACFy do begin
for i:=1 to nACFx do begin

x:=xx+(i-1)*center;
y:=yy+(j-1)*center;
SelectSlice(1);
MakeRoi(x,y,wacf,wacf);

			fft('foreward');
   fft1 := pidNumber;
   ImageMath('cmul', fft1, fft1, 1, 0, 'FFT2');
   fft2 := pidNumber;
   SelectPic(fft1);
   Dispose;
   SelectPic(fft2);
			fft('Inverse');
   fft('Swap Quadrants');

MakeRoi(corner,corner,center,center);
Copy;
Dispose;

ChooseSlice(2);
MakeRoi(x+corner,y+corner,center,center);
Paste;

ShowHistogram;
sum:=0;
index:=0;
for i:=1 to 255 do begin
sum:=sum+Histogram[i];
if (sum>threshold) and (index=0) then index:=i; 
end;

ChooseSlice(3);
MakeRoi(x+corner,y+corner,center,center);
Paste;
DoCopy;

SetThreshold(index);
MakeBinary;


SelectSlice(1);

end;
end;

end;

macro 'tiling of ACFs in 2-layer stack             [8]';
var 
  i,j,x,y,z,w,h,wim,him:integer;
 xx,yy,dummy,n,mean,mode,min,max:integer;
  wacf,nACFx,nACFy,corner,center:integer;
   fft1, fft2,fft0: integer;
  threshold,index,tarea,darea,sum:integer;

begin

CheckForStack;
SelectSlice(1);
GetPicSIze(wim,him);
wacf:= GetNumber('size of ACFs ',256);
xx:= GetNumber('Upper left corner of first ACF: x= ',0);
yy:= GetNumber('Upper left corner of first ACF: y= ',0);
max:=trunc((wim-xx)/wacf);
nACFx:= GetNumber('Number of ACFs in x-direction ? max = ',max);
max:=trunc((him-yy)/wacf);
nACFy:= GetNumber('Number of ACFs in y-direction ? max = ',max);

for j:=1 to nACFy do begin
for i:=1 to nACFx do begin

x:=xx+(i-1)*wacf;
y:=yy+(j-1)*wacf;

SelectSlice(1);
MakeRoi(x,y,wacf,wacf);

			fft('foreward');
   fft1 := pidNumber;
   ImageMath('cmul', fft1, fft1, 1, 0, 'FFT2');
   fft2 := pidNumber;
   SelectPic(fft1);
   Dispose;
   SelectPic(fft2);
			fft('Inverse');
   fft('Swap Quadrants');

MakeRoi(0,0,wacf,wacf);
Copy;
Dispose;

ChooseSlice(2);
MakeRoi(x,y,wacf,wacf);
Paste;
DoCopy;

SelectSlice(1);

end;
end;
end;

macro '(-' begin end;


macro 'individual ACFs -> set of slices [9]';
var
  i,j,x,y,z,w,h,wim,him:integer;
 xx,yy,dummy,n,mean,mode,min,max:integer;
  wacf,nACFx,nACFy,corner,center:integer;
   p1,fft1, fft2,fft0: integer;

begin

GetPicSIze(wim,him);
p1:=pidNumber;

wacf:= GetNumber('size of ACFs ',256);
xx:= GetNumber('Upper left corner of first ACF: x= ',0);
yy:= GetNumber('Upper left corner of first ACF: y= ',0);
max:=trunc((wim-xx)/wacf);
nACFx:= GetNumber('Number of ACFs in x-direction ? max = ',max);
max:=trunc((him-yy)/wacf);
nACFy:= GetNumber('Number of ACFs in y-direction ? max = ',max);
center:=wacf/2;
corner:=center/2;

for j:=1 to nACFy do begin
for i:=1 to nACFx do begin

SelectPic(p1);
x:=xx+(i-1)*wacf;
y:=yy+(j-1)*wacf;
MakeRoi(x,y,wacf,wacf);

			fft('foreward');
   fft1 := pidNumber;
   ImageMath('cmul', fft1, fft1, 1, 0, 'FFT2');
   fft2 := pidNumber;
   SelectPic(fft1);
   Dispose;
   SelectPic(fft2);
			fft('Inverse');
   fft('Swap Quadrants');

SelectAll;
Copy;
Dispose;

SetNewSize(wacf,wacf);
MakeNewWindow('ACF',j:2,i:2);
Paste;
SaveAs;
DIspose;

end;
end;
end;


macro 'analysis of ACF stack                [0]';
var
  i,j,x,y,z,w,h,wim,him:integer;
 xx,yy,dummy,n,mean,mode,min,max:integer;
  wacf,nACFx,nACFy,corner,center:integer;
  threshold,index,tarea,darea,sum:integer;
  scale:real;
  unit:string;

begin

CheckForStack;

GetPicSIze(wim,him);
darea:=(wim*him)/50;
darea:=GetNumber('Thresholded ACF size? 2% area =',darea);
threshold:=wim*him-darea;


for j:= 1 to nSlices do begin

SelectSlice(j);

SelectAll;
ShowHistogram;
sum:=0;
index:=0;

for i:=1 to 255 do begin
sum:=sum+Histogram[i];
if (sum>threshold) and (index=0) then index:=i; 
end;

SetThreshold(index);
MakeBinary;

 GetScale(scale,unit);
 SetUser1Label('ax.ratio');
 SetUser2Label('diameter');
 SetOptions('Major Minor User1 User2 Angle');
 AnalyzeParticles('label outline ignore include');
  rUser1[rCount]:=rMinor[rCount]/rMajor[rCount];
		rUser2[rCount]:=2*sqrt(rArea[rCount]/3.14159);

end;

ShowResults;
end;

macro '(-' begin end;

macro 'make ROI there   [X]';
var
x,y,left,top,width,height:integer;
begin
GetMouse(x,y);
GetPicSize(width,height);
 left:=GetNumber('left:',x);
 top:=GetNumber('top:',y);
 width:=GetNumber('width:',1200);
 height:=GetNumber('height:',1000);
MakeRoi(left,top,width,height);
end;

macro 'make center ROI [Z]';
var
 crop,left,top,width,height:integer;
begin
	GetPicSize(width,height);
 crop:=GetNumber('crop to 1/n of image    n = ?',4);
 left:=0.5*(crop-1)*width/crop;
 top:=0.5*(crop-1)*height/crop;
 width:=width/crop;
 height:=height/crop;
MakeRoi(left,top,width,height);
end;

macro '(-' begin end;


macro 'calibrate ACF to 100%       [T]';
begin 
Calibrate('straight','ACF(%)',0,0,255,100);

end;


macro 'subtract minimum of ACF  [A]';
var
  i,invno,width,height,OldStack:integer;
  n,mean,mode,min,max: integer;
  factor: real;
begin
   PutMessage('subtracts minimum in select reference area, (default = entire image)');
   Measure;
   GetResults(n,mean,mode,min,max);
   min:=GetNumber('minimum = ',min);
SelectAll;
    factor:=255/(255-min);
    AddConstant(-min);
    MultiplyByConstant(factor);
  UpdateLUT;
end;



macro 'ACF thresholding at 30 %  [B]';
var
  i,j,k1,k2,m:integer;
begin
 SetDensitySlice(77,255);
end;


macro 'ACF thresholding at 39 %  [C]';
var
  i,j,k1,k2,m:integer;
begin
 SetDensitySlice(100,255);
end;

macro '(-' begin end;


macro 'analysis of thresholded ACF -> list [D]';
var
  i,j,k1,k2,m:integer;
begin
 SetUser1Label('ax.ratio');
 SetUser2Label('eq.radius');
 SetOptions('Length User1 User2 Angle');
 AnalyzeParticles('label outline ignore include reset');
  for i:=1 to rCount do begin
  rUser1[i]:=rMinor[i]/rMajor[i];
			rUSer2[i]:=sqrt(rArea[i]/3.14159);
			end;
  ShowResults;
  
end;

macro 'analysis of ACFs -> list & label       [E]';
var
  i,j,k1,k2,m:integer;
  unit:string;
  scale:real;
begin
 GetScale(scale,unit);
 SetUser1Label('ax.ratio');
 SetUser2Label('eq.radius');
 SetOptions('Perimeter User1 User2 Angle');
 AnalyzeParticles('label outline ignore include reset');
  for i:=1 to rCount do begin
  rUser1[i]:=rMinor[i]/rMajor[i];
			rUSer2[i]:=sqrt(rArea[i]/3.14159);
k1:=scale*rX[i];
k2:=scale*rY[i]+40;
moveto(k1,k2);
Write(rUser1[i]:4:2);
			end;
  ShowResults;
end;




macro 'threshold ACF stack                        [F]';
var
  i,j,x,y,z,w,h,wim,him:integer;
  xx,yy,dummy,n,mean,mode,min,max:integer;
  wacf,nACFx,nACFy,corner,center:integer;
  threshold,index,darea,sum:integer;
  tarea:real;

begin

CheckForStack;
SelectSlice(1);
GetPicSIze(wim,him);

tarea:=GetNumber('Thresholded ACF size? window diameter =',wim);
tarea:=0.25*tarea*tarea*3.14159;
darea:=trunc(tarea);
threshold:=wim*him-darea;

for j:=1 to nSlices do begin

SelectSlice(j);
  ShowHistogram;
  sum:=0;
  index:=0;
    for i:=1 to 255 do begin
    sum:=sum+Histogram[i];
    if (sum>threshold) and (index=0) then index:=i; 
    end;

  SetThreshold(index);
  MakeBinary;

end;
end;

macro '(-' begin end;

macro 'transform to 20 levels       [Y]';
var
i,j,k,level,klo,kup:integer;
begin


for k:=0 to 12 do begin
      RedLUT[k]:=255;
      GreenLUT[k]:=255;
      BlueLUT[k]:=255;
end;

for j:=1 to 18 do begin

level:=(j*255)/19;

klo:=(j-1)*230/18 + 12;
kup:=j*230/18 + 12;

    for k:=klo to kup do begin
      RedLUT[k]:=255-level;
      GreenLUT[k]:=255-level;
      BlueLUT[k]:=255-level;
    end;
end;

for k:=kup+1 to 255 do begin
      RedLUT[k]:=0;
      GreenLUT[k]:=0;
      BlueLUT[k]:=0;
end;

UpdateLut;
end;



macro 'reset LUT    [R]';
begin
  ResetGrayMap;
end;
